home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGMISC
/
FORTRAN1.LZH
/
GETUSER.FOR
< prev
next >
Wrap
Text File
|
1988-02-08
|
2KB
|
85 lines
SUBROUTINE GETUSER ( USER )
C*
C* *******************************
C* *******************************
C* ** **
C* ** GETUSER **
C* ** **
C* *******************************
C* *******************************
C*
C* SUBPROGRAM :
C* GET USER NAME
C*
C* AUTHOR :
C* ART RAGOSTA
C* MS 207-5
C* AMES RESEARCH CENTER
C* MOFFETT FIELD, CA 94035
C* (415) 694-5578
C*
C* PURPOSE :
C* RETRIEVE THE NAME OF THE USER ACCOUNT CALLING THIS ROUTINE
C*
C* INPUT ARGUMENTS :
C* NONE
C*
C* OUTPUT ARGUMENTS :
C* USER - THE NAME OF THE USER
C*
C* INTERNAL WORK AREAS :
C* NONE
C*
C* COMMON BLOCKS :
C* NONE
C*
C* FILE REFERENCES :
C* NONE
C*
C* SUBPROGRAM REFERENCES :
C* JPI$_USERNAME, SYS$GETJPIW
C*
C* ERROR PROCESSING :
C* NONE
C*
C* TRANSPORTABILITY LIMITATIONS :
C* ABSOLUTELY NOT TRANSPORTABLE
C*
C* ASSUMPTIONS AND RESTRICTIONS :
C* NONE
C*
C* LANGUAGE AND COMPILER :
C* ANSI FORTRAN 77
C*
C* VERSION AND DATE :
C* VERSION I.0 7 JUNE 1985
C*
C* CHANGE HISTORY :
C* 07-JUN-1985 INITIAL VERSION
C*
C***********************************************************************
C*
CHARACTER *(*) USER
INTEGER *2 ITEM(2)
INTEGER *4 ITMLST(3), IOSB(2)
EQUIVALENCE (ITEM(1),ITMLST(1))
C
C --- ITEM CODE
C
EXTERNAL JPI$_USERNAME, SS$_NORMAL
C
C --- FILL ITMLST
C
ITEM(1) = 12
ITEM(2) = %LOC( JPI$_USERNAME )
ITMLST(2) = %LOC( USER )
ITMLST(3) = %LOC( LENG )
ISTAT = SYS$GETJPIW ( ,,, ITMLST, IOSB,, )
C
IF ( IOSB(1) .NE. %LOC(SS$_NORMAL) ) USER = 'ERROR'
RETURN
END
C
C---END GETUSER
C